perm filename PCALL2.SAI[PNT,HE]1 blob
sn#463376 filedate 1979-08-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00003 00003 ! eeditcall,redefinecall
C00008 ENDMK
C⊗;
ENTRY;
BEGIN "PCALL2"
COMMENT routines which are not available in AL;
DEFINE $PCALL2=TRUE,$ALTER_EGO=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;
! eeditcall,redefinecall;
INTERNAL PROCEDURE EEDITCALL;
BEGIN
RPTR(SYMBOL)EL;INTEGER OBTYPE;STRING FBODY;
RPTR(SCALAR,VECTOR,TRANS,FRAME,ROT,MACRO) TEMP;
STRING VAR;
NOEXPAND ← TRUE;
VAR←IDF_READ;
SEMICOL_READ;
EL←OLDSYM(VAR,OBTYPE); ! var must exist in $YMTAB;
TEMP←SYMBOL:OBJECT[EL];
IF OBTYPE = #MC
THEN BEGIN
INTEGER BRCHAR;
STRING OLD_STRING;
OLD_STRING← "REDEFINE "&MACRO:HEAD[SYMBOL:OBJECT[EL]]
&" = "&CVSYM(EL,EDIT_D)&";";
SWAP(OLD_STRING);
ASKUSER(OLD_STRING);
ALINIT;
END
ELSE ERROR("EEDIT: only valid for macros");
NOEXPAND ← FALSE;
END;
INTERNAL PROCEDURE REDEFINECALL;
BEGIN RPTR(MACRO) MACPTR; STRING MACNAME; INTEGER DDLCOUNT; STRING BODY,NBODY;
RPTR(SYMBOL)EL; RANY TEMP;
INTEGER NPARAM; INTEGER OBTYPE;
NPARAM←0;
NOEXPAND ← TRUE;
MACNAME←IDF_READ;
EL←OLDSYM(MACNAME,OBTYPE); ! macname must exist in $YMTAB;
TEMP←SYMBOL:OBJECT[EL];
IF OBTYPE≠#MC
THEN ERROR("MACRO REDEFINITION: need macro name");
DDLCOUNT ← 0;
MACPTR ← SYMBOL:OBJECT[EL];
GTOKEN;
IF TOKEN≠"("
THEN BEGIN STOKEN←TRUE; MACRO:HEAD[MACPTR]←MACNAME; END
ELSE
BEGIN "parametered macro"
RCLASS PLIST(STRING PARAM; RPTR(PLIST) NEXTP);
RPTR(PLIST) TEMP,TEMP0;
TEMP0←NULL_RECORD;
DO
BEGIN "get parameters"
GTOKEN;
IF #TOKEN ≠ UNDECLARED_TYPE THEN
ERROR("MACRO DEFINITION: need undeclared token for argument");
NPARAM←NPARAM+1;
TEMP←NEW!RECORD(PLIST);
PLIST:NEXTP[TEMP]←TEMP0;
PLIST:PARAM[TEMP]←TOKEN;
TEMP0←TEMP;
GTOKEN;
IF TOKEN≠")" AND TOKEN≠","
THEN ERROR("MACRO DEFINITION: Need comma here");
END "get parameters" UNTIL TOKEN=")";
BEGIN
INTEGER I; STRING ARRAY S[1:NPARAM];
STRING HEAD; HEAD←")";
FOR I←NPARAM STEP -1 UNTIL 1 DO
BEGIN
HEAD←","&(S[I]←PLIST:PARAM[TEMP])&HEAD;
TEMP←PLIST:NEXTP[TEMP];
END;
MEMORY[LOCATION(S)]↔MEMORY[LOCATION(MACRO:PRLIST[MACPTR])];
MACRO:HEAD[MACPTR]←MACNAME&"("&HEAD[2 TO ∞];
END;
MACRO:NPARAM[MACPTR]←NPARAM;
END "parametered macro";
WORD_READ("=");
WORD_READ("⊂"); DDLCOUNT ← 1;
BODY←"⊂";
DO BEGIN
INTEGER I;
I←READTILL("⊂⊃");
BODY←BODY&TOKEN&I;
IF I="⊂"
THEN DDLCOUNT ← DDLCOUNT + 1
ELSE DDLCOUNT ← DDLCOUNT - 1;
END UNTIL DDLCOUNT=0;
BODY←BODY[2 TO ∞-1];
IF NPARAM>0 THEN
BEGIN
NBODY←NULL;
WHILE BODY DO
BEGIN "process the parameters"
INTEGER I;
INTEGER BRCHAR; STRING TTOKEN;
NBODY←NBODY&SCAN(BODY,$LTTAB,BRCHAR);
TTOKEN←SCAN(BODY,$NLTTAB,BRCHAR);
FOR I←1 STEP 1 UNTIL NPARAM
DO IF EQU(MACRO:PRLIST[MACPTR][I],TTOKEN) THEN DONE;
IF I>NPARAM THEN
NBODY←NBODY&TTOKEN
ELSE NBODY←NBODY&DUMMY_DELIM&TTOKEN&DUMMY_DELIM;
END "process the parameters";
END ELSE NBODY←BODY;
MACRO:BODY[MACPTR]←NBODY;
SEMICOL_READ;
NOEXPAND ← FALSE;
$MCLST←NULL;
END;
END "PCALL2"